home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol153 / stress.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1986-12-16  |  5.5 KB  |  161 lines
  1. 10  '*************************************************************************
  2. 20  '                    HOLMES LIFE CHANGE EVENTS INDEX
  3. 30  '                        Lawrence R. Walker, Ph.D.
  4. 40  '                           VERSION 1.1     1984
  5. 50  '*************************************************************************
  6. 60  KEY OFF:CLS:GOSUB 960:CLS:DIM CHANGE$(5)
  7. 70  LOCATE 3,25:PRINT   "HOLMES LIFE CHANGE EVENTS INDEX"
  8. 80  LOCATE 5,13:PRINT   "This questionnaire will help you analyze the stress"
  9. 90  LOCATE 6,13:PRINT   "that may be caused by changes in your life"
  10. 100  LOCATE 8,13:PRINT   "The Life Change Events Index was originally developed by"
  11. 110  LOCATE 9,13:PRINT   "Dr. Thomas Holmes, M.D., Professor of Psychiatry at the"
  12. 120  LOCATE 10,13:PRINT  "University of Washington.  The Index consist of 43 life"
  13. 130  LOCATE 11,13:PRINT  "events with weights ranging from 100 to 11 attached to"
  14. 140  LOCATE 12,13:PRINT  "each.  It has been found that the as the rate of change"
  15. 150  LOCATE 13,13:PRINT  "in our life increases, the greater the vulnerability or"
  16. 160  LOCATE 14,13:PRINT  "lowering of resistance to disease, and the more serious"
  17. 170  LOCATE 15,13:PRINT  "the disease that does develop."
  18. 180  LOCATE 17,13:PRINT  "If one of the following events has been true for you"
  19. 190  LOCATE 18,13:PRINT "during the past year or will occur in the near future,"
  20. 200  LOCATE 19,13:PRINT "please press the number <1>.  Otherwise, press the "
  21. 210  LOCATE 20,13:PRINT "number <2>"
  22. 220  LOCATE 23,27:PRINT "PRESS ANY KEY TO CONTINUE"
  23. 230  A$=INKEY$:IF A$="" THEN 230
  24. 240  FOR I=1 TO 43
  25. 250  READ EVENT$,IMPACT:ADJUST=(80-LEN(EVENT$))/2
  26. 260  CLS:LOCATE 4,ADJUST:PRINT EVENT$
  27. 270  LOCATE 7,37:PRINT "<1>  Yes"
  28. 280  LOCATE 9,37:PRINT "<2>  No"
  29. 290  LOCATE 12,28:PRINT "Please enter your response"
  30. 300  LOCATE 14,31:PRINT "Do NOT press <ENTER>"
  31. 310  B$=INKEY$:IF B$="" THEN 310
  32. 320  IF VAL(B$)<>INT(1) AND VAL(B$)<>INT(2) GOTO 260
  33. 330  IF VAL(B$)=1 THEN TOTAL=TOTAL+IMPACT
  34. 340  B$=""
  35. 350  NEXT I
  36. 360  CLS:LOCATE 10,26:PRINT "Your Life Change Index is";TOTAL
  37. 370  FOR J=1 TO 5:READ CHANGE$(J):NEXT J
  38. 380  IF TOTAL >=300 THEN K=1:GOTO 430
  39. 390  IF TOTAL >=250 AND TOTAL <=299 THEN K=2:GOTO 430
  40. 400  IF TOTAL >=200 AND TOTAL <=249 THEN K=3:GOTO 430
  41. 410  IF TOTAL >=150 AND TOTAL <=199 THEN K=4:GOTO 430
  42. 420  K=5
  43. 430  ADJUST=(80-LEN(CHANGE$(K)))/2:LOCATE 12,ADJUST:PRINT CHANGE$(K)
  44. 440  LOCATE 18,9:PRINT "Thank you very much for taking time to answer this questionnaire"
  45. 450  LOCATE 22,26:PRINT "PRESS ANY KEY TO END PROGRAM"
  46. 460  E$=INKEY$:IF E$="" THEN 460
  47. 470  CLS:END
  48. 480  DATA Death of Spouse,100
  49. 490  DATA Divorce,73
  50. 500  DATA Marital Separation,65
  51. 510  DATA Jail Term,63
  52. 520  DATA Death of Close Family Member,63
  53. 530  DATA Personal Injury or Illness,53
  54. 540  DATA Marriage,50
  55. 550  DATA Fired at Work,47
  56. 560  DATA Marital Reconciliation,45
  57. 570  DATA Retirement,45
  58. 580  DATA Change in Health of Family Member,44
  59. 590  DATA Pregnancy,40
  60. 600  DATA Sex Difficulties,39
  61. 610  DATA Gain of New Family Member,39
  62. 620  DATA Business Readjustment,39
  63. 630  DATA Change in Financial State,38
  64. 640  DATA Death of Close Friend,37
  65. 650  DATA Change to Different Line of Work,36
  66. 660  DATA Change in Number of Arguments with Spouse,35
  67. 670  DATA "Mortgage over $50,000",31
  68. 680  DATA Foreclosure of Mortgage or Loan,30
  69. 690  DATA Change in Responsibilities at Work,29
  70. 700  DATA Son or Daughter Leaving Home,29
  71. 710  DATA Trouble with In-Laws,29
  72. 720  DATA Outstanding Personal Achievement,28
  73. 730  DATA Spouse Begins or Stops Work,26
  74. 740  DATA Begin or End School,26
  75. 750  DATA Change in Living Conditions,25
  76. 760  DATA Revision of Personal Habits,24
  77. 770  DATA Trouble with Boss,23
  78. 780  DATA Change in Work Hours or Conditions,20
  79. 790  DATA Change in Residence,20
  80. 800  DATA Change in Schools,20
  81. 810  DATA Change in Recreation,19
  82. 820  DATA Change in Church Activities,19
  83. 830  DATA Change in Social Activities,18
  84. 840  DATA "Mortgage or Loan less than $50,000",17
  85. 850  DATA Change in Sleeping Habits,15
  86. 860  DATA Change in Number of Family Get-Togethers,15
  87. 870  DATA Change in Eating Habits,15
  88. 880  DATA Vacation,13
  89. 890  DATA Christmas (if approaching),12
  90. 900  DATA Minor Violations of the Law,11
  91. 910  DATA Your Score Indicates You Have Had Major Life Change
  92. 920  DATA Your Score Indicates You Have Had Serious Life Change
  93. 930  DATA Your Score Indicates You Have Had Moderate Life Change
  94. 940  DATA Your Score Indicates You Have Had Mild Life Change
  95. 950  DATA Your Score Indicates You Have Had Very Little Life Change
  96. 960  Z$=STRING$(80,"*"):PRINT Z$;:PRINT Z$;:LOCATE 22,1:PRINT Z$;:LOCATE 23,1:PRINT Z$;
  97. 970  X$="**"
  98. 980  C=2
  99. 990  C=C+1
  100. 1000  LOCATE C,1:PRINT X$;:LOCATE C,79:PRINT X$
  101. 1010  IF C=21 THEN 1030
  102. 1020  GOTO 990
  103. 1030  COLOR 9,0
  104. 1040  LOCATE 6,36:PRINT "HEY YOU"
  105. 1050  FOR X=1 TO 6000:NEXT X
  106. 1060  COLOR 25,0
  107. 1070  LOCATE 10,33:PRINT "!! YES, YOU !!"
  108. 1080  FOR X=1 TO 6000
  109. 1090  NEXT X
  110. 1100  COLOR 7,0
  111. 1110  LOCATE 16,28:PRINT "HOW'S LIFE BEEN TREATING"
  112. 1120  LOCATE 17,38:PRINT "YOU"
  113. 1130  LOCATE 18,36:PRINT "LATELY?"
  114. 1140  FOR X=1 TO 12000:NEXT X
  115. 1150  COLOR 7,0
  116. 1160  CLS
  117. 1170  LOCATE 1,39: PRINT "**"
  118. 1180  LOCATE 24,39: PRINT "**"
  119. 1190  LOCATE 2,37:PRINT "******
  120. 1200  LOCATE 23,37:PRINT "******
  121. 1210  LOCATE 3,34:PRINT "************"
  122. 1220  LOCATE 22,34:PRINT "************"
  123. 1230  LOCATE 4,28:PRINT "************************"
  124. 1240  LOCATE 21,28:PRINT "************************"
  125. 1250  LOCATE 5,22:PRINT "************************************"
  126. 1260  LOCATE 20,22:PRINT "************************************"
  127. 1270  LOCATE 6,16:PRINT "************************************************"
  128. 1280  LOCATE 19,16:PRINT "************************************************"
  129. 1290  LOCATE 11,27:PRINT "DON'T LET STRESS MAKE YOU"
  130. 1300  LOCATE 12,32: PRINT "ITS NEXT VICTIM"
  131. 1310  FOR X = 1 TO 6000: NEXT X
  132. 1320  LOCATE 14,24:PRINT "FIND OUT BEFORE IT'S TOO LATE !"
  133. 1330  FOR X= 1 TO 12000: NEXT X
  134. 1340  CLS
  135. 1350  GOSUB 1500
  136. 1360  RT=1:CL=1:CR=80:RB=21
  137. 1370  FOR I=1 TO 5
  138. 1380  LOCATE RT,CL+1
  139. 1390  PRINT STRING$(CR-CL-1,CHR$(205));
  140. 1400  PRINT CHR$(187)
  141. 1410  FOR J=RT+1 TO RB-1:LOCATE J,CR:PRINT CHR$(186):NEXT J
  142. 1420  LOCATE RB,CR:PRINT CHR$(188)
  143. 1430  FOR J=CR-1 TO CL+1 STEP -1:LOCATE RB,J:PRINT CHR$(205):NEXT J
  144. 1440  LOCATE RB,CL:PRINT CHR$(200)
  145. 1450  FOR J=RB-1 TO RT+1 STEP -1:LOCATE J,CL:PRINT CHR$(186):NEXT J
  146. 1460  LOCATE RT,CL:PRINT CHR$(201)
  147. 1470  RT=RT+2:CL=CL+2:CR=CR-2:RB=RB-2
  148. 1480  NEXT I
  149. 1490  GOTO 1570
  150. 1500  FOR I=1 TO 27
  151. 1510  LOCATE 10,I:PRINT CHR$(16);" HOLMES LIFE CHANGE INDEX ";CHR$(17)
  152. 1520  FOR K=1 TO 50:NEXT K
  153. 1530  IF I=27 THEN 1560
  154. 1540  LOCATE 10,I:PRINT " "
  155. 1550  NEXT I
  156. 1560  RETURN
  157. 1570  LOCATE 11,18:PRINT "Program written by Lawrence R. Walker, Ph.D."
  158. 1580  LOCATE 12,34:PRINT "version 1.1"
  159. 1590  FOR I=1 TO 12000:NEXT I
  160. 1600  RETURN
  161.